unit uDZGraphics;

interface

uses
  SysUtils, Classes, Consts, Windows, Graphics, uDZVclBase;

type
  TFillMode = (fmNone, fmStretch, fmTile);
  TDzMarginBitmap = class(TComponent)
  private
    fUpdateCount: Integer;
    fGraphic: TBitmap;
    fMarginLeft: Integer;
    fMarginRight: Integer;
    fMarginTop: Integer;
    fMarginBottom: Integer;
    fOnChange: array of TExNotifyEvent;
    fFillMode: TFillMode;
    fRowCount: Integer;
    fColCount: Integer;
    procedure SetIntegerField(var field: Integer; value: Integer);
    procedure SetGraphic(const Value: TBitmap);
    procedure SetMarginBottom(const Value: Integer);
    procedure SetMarginLeft(const Value: Integer);
    procedure SetMarginRight(const Value: Integer);
    procedure SetMarginTop(const Value: Integer);
    procedure PictureChanged(Sender: TObject);
    procedure DoChange(ID: TNotifyID);
    procedure SetTransparent(const Value: Boolean);
    procedure SetTransparentColor(const Value: TColor);
    function GetTransparent: Boolean;
    function GetTransparentColor: TColor;
    procedure SetFillMode(const Value: TFillMode);
    procedure SetColCount(const Value: Integer);
    procedure SetRowCount(const Value: Integer);
    function GetGlyphCount: Integer;
    function GetHeight: Integer;
    function GetWidth: Integer;
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure DrawTo(GlyphIndex: Integer; Canvas: TCanvas; 
      Left, Top, Width, Height: Integer);
    procedure AddOnChangeListener(listener: TExNotifyEvent);
    procedure RemoveOnChangeListener(listener: TExNotifyEvent);
    property GlyphCount: Integer read GetGlyphCount;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
  published
    property Graphic: TBitmap read fGraphic write SetGraphic;
    property RowCount: Integer read fRowCount write SetRowCount;
    property ColCount: Integer read fColCount write SetColCount;
    property MarginLeft: Integer read fMarginLeft write SetMarginLeft;
    property MarginRight: Integer read fMarginRight write SetMarginRight;
    property MarginTop: Integer read fMarginTop write SetMarginTop;
    property MarginBottom: Integer read fMarginBottom write SetMarginBottom;
    property FillMode: TFillMode read fFillMode write SetFillMode;
    property Transparent: Boolean read GetTransparent write SetTransparent;
    property TransparentColor: TColor read GetTransparentColor
      write SetTransparentColor default clFuchsia;
  end;

implementation

type
  THackCanvas = class(TCanvas);

procedure GDIError;
var
  ErrorCode: Integer;
  Buf: array [Byte] of Char;
begin
  ErrorCode := GetLastError;
  if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil,
    ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then
    raise EOutOfResources.Create(Buf)
  else
    raise EOutOfResources.Create(SOutOfResources);
end;

function GDICheck(Value: Integer): Integer;
begin
  if Value = 0 then GDIError;
  Result := Value;
end;

procedure CopyDC(SrcDC, DestDC: HDC; SrcLeft, SrcTop, SrcWidth, SrcHeight,
  DestLeft, DestTop, DestWidth, DestHeight: Integer;
  Transparent: Boolean; TransparentColor: TColor; Rop: Integer);
begin
  if Transparent then
    TransparentBlt(DestDC, DestLeft, DestTop, DestWidth, DestHeight,
      SrcDC, SrcLeft, SrcTop, SrcWidth, SrcHeight, TransparentColor)
  else
    StretchBlt(DestDC, DestLeft, DestTop, DestWidth, DestHeight,
      SrcDC, SrcLeft, SrcTop, SrcWidth, SrcHeight, Rop);
end;

procedure MarginStretchBlt(SrcDC, DestDC: HDC; SrcLeft, SrcTop, SrcWidth,
  SrcHeight, DestLeft, DestTop, DestWidth, DestHeight,
  MarginLeft, MarginTop, MarginRight, MarginBottom: Integer;
  Transparent: Boolean; TransparentColor: TColor; Rop: Integer);
begin
  CopyDC(SrcDC, DestDC, SrcLeft, SrcTop, MarginLeft, MarginTop,
    DestLeft, DestTop, MarginLeft, MarginTop,
    Transparent, TransparentColor, Rop);
    
  CopyDC(SrcDC, DestDC, SrcLeft + SrcWidth - MarginRight, SrcTop, MarginRight,
    MarginTop, DestLeft + DestWidth - MarginRight, DestTop, MarginRight,
    MarginTop, Transparent, TransparentColor, Rop);

  CopyDC(SrcDC, DestDC, SrcLeft, SrcTop + SrcHeight - MarginBottom, MarginLeft,
    MarginBottom, DestLeft, DestTop + DestHeight - MarginBottom, MarginLeft,
    MarginBottom, Transparent, TransparentColor, Rop);

  CopyDC(SrcDC, DestDC, SrcLeft + SrcWidth - MarginRight,
    SrcTop + SrcHeight - MarginBottom, MarginRight, MarginBottom,
    DestLeft + DestWidth - MarginRight, DestTop + DestHeight - MarginBottom,
    MarginRight, MarginBottom, Transparent, TransparentColor, Rop);

  CopyDC(SrcDC, DestDC, SrcLeft + MarginLeft, SrcTop,
    SrcWidth - MarginLeft - MarginRight, MarginTop,
    DestLeft + MarginLeft, DestTop, DestWidth - MarginLeft - MarginRight,
    MarginTop, Transparent, TransparentColor, Rop);

  CopyDC(SrcDC, DestDC, SrcLeft + MarginLeft, SrcTop + SrcHeight - MarginBottom,
    SrcWidth - MarginLeft - MarginRight, MarginBottom,
    DestLeft + MarginLeft, DestTop + DestHeight - MarginBottom,
    DestWidth - MarginLeft - MarginRight, MarginBottom, Transparent,
    TransparentColor, Rop);

  CopyDC(SrcDC, DestDC, SrcLeft, SrcTop + MarginTop, MarginLeft,
    SrcHeight - MarginTop - MarginBottom, DestLeft, DestTop + MarginTop,
    MarginLeft, DestHeight - MarginTop - MarginBottom,
    Transparent, TransparentColor, Rop);

  CopyDC(SrcDC, DestDC, SrcLeft + SrcWidth - MarginRight, SrcTop + MarginTop,
    MarginRight, SrcHeight - MarginTop - MarginBottom,
    DestLeft + DestWidth - MarginRight, DestTop + MarginTop,
    MarginRight, DestHeight - MarginTop - MarginBottom,
    Transparent, TransparentColor, Rop);

  StretchBlt(DestDC, DestLeft + MarginLeft, DestTop + MarginTop,
    DestWidth - MarginLeft - MarginRight,
    DestHeight - MarginTop - MarginBottom,
    SrcDC,
    SrcLeft + MarginLeft, SrcTop + MarginTop,
    SrcWidth - MarginLeft - MarginRight,
    SrcHeight - MarginTop - MarginBottom,
    Rop); 
end;

{ TDzMarginBitmap }

procedure TDzMarginBitmap.AddOnChangeListener(listener: TExNotifyEvent);
var
  i: Integer;
begin
  if csDestroying in ComponentState then
    raise Exception.Create('Referring destroying component.');
  for i := Low(fOnChange) to High(fOnChange) do
  begin
    if ((TMethod(fOnChange[i])).Data = TMethod(listener).Data) and
      ((TMethod(fOnChange[i])).Code = TMethod(listener).Code) then Exit;
  end;
  SetLength(fOnChange, Length(fOnChange) + 1);
  fOnChange[High(fOnChange)] := listener;
end;

procedure TDzMarginBitmap.Assign(Source: TPersistent);
begin
  if not Assigned(Source) then inherited
  else if Source is TGraphic then
  begin
    fGraphic.Assign(Source);
    DoChange(niChange);
  end
  else if Source is TDzMarginBitmap then
  begin
    fGraphic.Assign(TDzMarginBitmap(Source).fGraphic);
    fMarginLeft := TDzMarginBitmap(Source).MarginLeft;
    fMarginRight := TDzMarginBitmap(Source).MarginRight;
    fMarginTop := TDzMarginBitmap(Source).MarginTop;
    fMarginBottom := TDzMarginBitmap(Source).MarginBottom;
    DoChange(niChange);
  end
  else inherited;
end;

procedure TDzMarginBitmap.AssignTo(Dest: TPersistent);
begin
  if not Assigned(Dest) then inherited;
  if Dest is TGraphic then fGraphic.Assign(Dest)
  else inherited;
end;

procedure TDzMarginBitmap.BeginUpdate;
begin
  Inc(fUpdateCount);
end;

constructor TDzMarginBitmap.Create(Owner: TComponent);
begin
  inherited;
  fGraphic := TBitmap.Create;
  fGraphic.OnChange := Self.PictureChanged;
  fRowCount := 1;
  fColCount := 1;
end;

destructor TDzMarginBitmap.Destroy;
begin
  DoChange(niDestroy);
  SetLength(fOnChange, 0);
  fGraphic.Free;
  inherited;
end;

procedure TDzMarginBitmap.DoChange(ID: TNotifyID);
var
  i: Integer;
begin
  if (fUpdateCount = 0) or (ID = niDestroy) then
  begin
    i := High(fOnChange);
    while i >= Low(fOnChange) do
    begin
      fOnChange[i](Self, ID);
      Dec(i);
      if i > High(fOnChange) then
        i := High(fOnChange);
    end;
  end;
end;

procedure TDzMarginBitmap.DrawTo(GlyphIndex: Integer; Canvas: TCanvas;
  Left, Top, Width, Height: Integer);
var
  OldPalette, Palette: HPALETTE;
  DestDC, SrcDC: HDC;
  PitchLeft, PitchTop, PitchWidth, PitchHeight: Integer;
begin
  DestDC := Canvas.Handle;
  SrcDC := fGraphic.Canvas.Handle;
  Palette := fGraphic.Palette;
  OldPalette := 0;

  if Palette <> 0 then
  begin
    OldPalette := SelectPalette(DestDC, Palette, True);
    RealizePalette(DestDC);
  end;

  SetStretchBltMode(DestDC, STRETCH_DELETESCANS);

  PitchWidth := fGraphic.Width div fColCount;
  PitchHeight := fGraphic.Height div fRowCount;
  PitchLeft := PitchWidth * (GlyphIndex mod fColCount);
  PitchTop := PitchHeight * (GlyphIndex div fColCount);
  try
    if fFillMode <> fmNone then
    begin
      MarginStretchBlt(SrcDC, DestDC, PitchLeft, PitchTop, PitchWidth,
        PitchHeight, Left, Top, Width, Height, fMarginLeft, fMarginTop,
        fMarginRight, fMarginBottom, Transparent, fGraphic.TransparentColor,
        Canvas.CopyMode);
    end
    else begin
      if Width > PitchWidth then Width := PitchWidth;
      if Height > PitchHeight then Height := PitchHeight;
      if fGraphic.Transparent then
        TransparentBlt(DestDC, Left, Top, Width, Height, SrcDC, PitchLeft,
          PitchTop, Width, Height, fGraphic.TransparentColor)
      else
        BitBlt(DestDC, Left, Top, Width, Height, SrcDC,
          PitchLeft, PitchTop, Canvas.CopyMode);
    end;
  finally
    if Palette <> 0 then
      SelectPalette(Canvas.Handle, OldPalette, True);
  end;
end;

procedure TDzMarginBitmap.EndUpdate;
begin
  Dec(fUpdateCount);
end;

function TDzMarginBitmap.GetGlyphCount: Integer;
begin
  Result := fRowCount * fColCount;
end;

function TDzMarginBitmap.GetHeight: Integer;
begin
  Result := fGraphic.Height div fRowCount;
end;

function TDzMarginBitmap.GetTransparent: Boolean;
begin
  Result := fGraphic.Transparent;
end;

function TDzMarginBitmap.GetTransparentColor: TColor;
begin
  Result := fGraphic.TransparentColor;
end;

function TDzMarginBitmap.GetWidth: Integer;
begin
  Result := fGraphic.Width div fColCount;
end;

procedure TDzMarginBitmap.PictureChanged(Sender: TObject);
begin
  DoChange(niChange);
end;

procedure TDzMarginBitmap.RemoveOnChangeListener(listener: TExNotifyEvent);
var
  i, j: Integer;
begin
  for i := Low(fOnChange) to High(fOnChange) do
  begin
    if ((TMethod(fOnChange[i])).Data = TMethod(listener).Data) and
      ((TMethod(fOnChange[i])).Code = TMethod(listener).Code) then
    begin
      for j := i to High(fOnChange) - 1 do
        fOnChange[i] := fOnChange[i + 1];
      SetLength(fOnChange, Length(fOnChange) - 1);
      Break;
    end;
  end;
end;

procedure TDzMarginBitmap.SetColCount(const Value: Integer);
begin
  if (fColCount <> Value) and (Value >= 1) then
  begin
    fColCount := Value;
    DoChange(niChange);
  end;
end;

procedure TDzMarginBitmap.SetFillMode(const Value: TFillMode);
begin
  if fFillMode <> Value then
  begin
    fFillMode := Value;
    DoChange(niChange);
  end;
end;

procedure TDzMarginBitmap.SetGraphic(const Value: TBitmap);
begin
  if fGraphic <> Value then
    fGraphic.Assign(Value);
end;

procedure TDzMarginBitmap.SetIntegerField(var field: Integer;
  value: Integer);
begin
  if field <> value then
  begin
    field := value;
    DoChange(niChange);
  end;
end;

procedure TDzMarginBitmap.SetMarginBottom(const Value: Integer);
begin
  SetIntegerField(fMarginBottom, Value);
end;

procedure TDzMarginBitmap.SetMarginLeft(const Value: Integer);
begin
  SetIntegerField(fMarginLeft, Value);
end;

procedure TDzMarginBitmap.SetMarginRight(const Value: Integer);
begin
  SetIntegerField(fMarginRight, Value);
end;

procedure TDzMarginBitmap.SetMarginTop(const Value: Integer);
begin
  SetIntegerField(fMarginTop, Value);
end;

procedure TDzMarginBitmap.SetRowCount(const Value: Integer);
begin
  if (fRowCount <> Value) and (value >= 1) then
  begin
    fRowCount := Value;
    DoChange(niChange);
  end;
end;

procedure TDzMarginBitmap.SetTransparent(const Value: Boolean);
begin
  if fGraphic.Transparent <> Value then
  begin
    fGraphic.Transparent := Value;
    DoChange(niChange);
  end;
end;

procedure TDzMarginBitmap.SetTransparentColor(const Value: TColor);
begin
  if fGraphic.TransparentColor <> Value then
  begin
    fGraphic.TransparentColor := Value;
    DoChange(niChange);
  end;
end;

end.
